home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / tcl / spectcl-.000 / spectcl- / usr / local / SpecTcl-0.1a / edit.ui.tcl < prev    next >
Encoding:
Text File  |  1995-11-06  |  3.0 KB  |  120 lines
  1. # SpecTcl, by S. A. Uhler
  2. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  3. #
  4. # See the file "license.txt" for information on usage and redistribution
  5. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  6. #
  7. # interface generated from edit.ui
  8. #   root     is the parent window for this user interface
  9.  
  10. proc edit_ui {root args} {
  11.  
  12.     # this treats "." as a special case
  13.  
  14.     if {$root == "."} {
  15.         set base ""
  16.     } else {
  17.         set base $root
  18.     }
  19.     
  20.     frame $base.frame#1
  21.  
  22.     scrollbar $base.scrollbar#1 \
  23.         -command "$base.text yview" \
  24.         -orient v
  25.  
  26.     text $base.text \
  27.         -height 20 \
  28.         -width 60 \
  29.         -wrap none \
  30.         -xscrollcommand "$base.scrollbar#2 set" \
  31.         -yscrollcommand "$base.scrollbar#1 set"
  32.     catch {
  33.         $base.text configure \
  34.             -font -*-Courier-Medium-R-Normal--*-140-*-*-*-*-*-*
  35.     }
  36.  
  37.     scrollbar $base.scrollbar#2 \
  38.         -command "$base.text xview" \
  39.         -orient h
  40.  
  41.     button $base.dismiss \
  42.         -command "set Current(dirty) 1;set f(code) \[$base.text get 1.0 end\];destroy $root" \
  43.         -padx 11 \
  44.         -pady 4 \
  45.         -text Dismiss
  46.  
  47.     button $base.apply \
  48.         -command "set Current(dirty) 1; set f(code) \[$base.text get 1.0 end\]" \
  49.         -padx 11 \
  50.         -pady 4 \
  51.         -text Apply
  52.     catch {
  53.         $base.apply configure \
  54.             -font -*-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
  55.     }
  56.  
  57.     button $base.revert \
  58.         -command "append f(code) {}; $root.text delete 1.0 end; $root.text insert 1.0 \$f(code)" \
  59.         -padx 11 \
  60.         -pady 4 \
  61.         -text Revert
  62.  
  63.  
  64.     # Geometry management
  65.  
  66.     blt_table $root $base.frame#1     3,1  \
  67.         -columnspan 2
  68.     blt_table $root $base.scrollbar#1     1,1  \
  69.         -fill y
  70.     blt_table $root $base.text     1,2  \
  71.         -fill both
  72.     blt_table $root $base.scrollbar#2     2,2  \
  73.         -fill x
  74.     blt_table $base.frame#1 $base.dismiss     1,1 
  75.     blt_table $base.frame#1 $base.apply     1,2 
  76.     blt_table $base.frame#1 $base.revert     1,3 
  77.  
  78.     # Resize behavior management
  79.  
  80.     blt_table row $root configure all -resize none
  81.     blt_table row $root configure 1 -resize both
  82.     blt_table row $root configure 1 -height {225 Inf}
  83.     blt_table row $root configure 2 -height {30 Inf}
  84.     blt_table row $root configure 3 -height {30 Inf}
  85.     blt_table column $root configure all -resize none
  86.     blt_table column $root configure 2 -resize both
  87.     blt_table column $root configure 1 -width {30 Inf}
  88.     blt_table column $root configure 2 -width {359 Inf}
  89.  
  90.     blt_table row $base.frame#1 configure all -resize none
  91.     blt_table row $base.frame#1 configure 1 -height {30 Inf}
  92.     blt_table column $base.frame#1 configure all -resize none
  93.     blt_table column $base.frame#1 configure 1 -width {30 Inf}
  94.     blt_table column $base.frame#1 configure 2 -width {30 Inf}
  95.     blt_table column $base.frame#1 configure 3 -width {30 Inf}
  96. # additional interface code
  97. global f Clip
  98. bind $base.text <Control-w> {
  99.    if {$Current(widget) != ""} {
  100.       upvar #0 [winfo name $Current(widget)] data
  101.       %W insert insert $data(item_name)
  102.    }
  103. }
  104. bind $base.text <Control-c> {
  105.    set Clip [%W get sel.first sel.last]
  106. }
  107. bind $base.text <Control-v> {
  108.    %W insert insert $Clip
  109. }
  110. append f(code) {}
  111. $base.text insert 1.0 $f(code)
  112. tkwait visibility $root
  113. focus $base.text
  114.  
  115.  
  116.  
  117. # end additional interface code
  118.  
  119. }
  120.